/*
 * Copyright (C) 2008,2009,2010,2011  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

#if 0	/* FIXME need to check arguments of round/ceil/floor */
#include <fenv.h>
#endif

#if defined(__linux__) && defined(__i386__)
#  include <fpu_control.h>
#endif

/*
 * Types
 */
typedef struct note note_t;

/* NOTE this structure is stored in eeval() stack. If a longjmp()
 * is used, need to restore the global note variable */
struct note {
    note_t	*prev;
    eobject_t	 value;
};

/*
 * Prototypes
 */
static eblock_t *
new_block(etoken_t token);

static void
del_block(void);

static void
keep_block(eblock_t *block, eint32_t flags);

static void
add_t_jump(eblock_t *block, east_node_t *node);

static void
add_f_jump(eblock_t *block, east_node_t *node);

static void
patch_jump(elabel_t *label, east_node_t *node);

static etag_t *
apply(eobject_t object, eobject_t list);

static etag_t *
statement(eobject_t list);

static etag_t *
ternary_statement(eobject_t list);

static void
if_statement(eobject_t list);

static void
while_statement(eobject_t list);

static void
for_statement(eobject_t list);

static void
do_statement(eobject_t list);

static void
switch_finalize(eblock_t *block, east_list_t *test, east_list_t *done,
		eentry_t *entry);

static void
switch_statement(eobject_t list);

static void
case_add_label(ehash_t *hash, eobject_t object, ebool_t check);

static void
case_label(eobject_t list);

static void
default_label(void);

static etag_t *
set_expression(eobject_t list);

static etag_t *
setop_expression(ecode_t code, eobject_t list);

static etag_t *
incdec_expression(ecode_t code, eobject_t list, ebool_t post);

static etag_t *
unary_expression(ecode_t code, eobject_t list);

static etag_t *
binary_expression(ecode_t code, eobject_t list);

static void
cond_expression(etoken_t token, eobject_t list);

static etag_t *
new_expression(eobject_t list);

static etag_t *
new_vector(eobject_t list);

static etag_t *
rankof_expression(eobject_t list);

static etag_t *
sizeof_expression(eobject_t list);

static etag_t *
typeof_expression(eobject_t list);

static etag_t *
subtypeof_expression(eobject_t list);

static etag_t *
renew_expression(eobject_t list);

static efunction_t *
prototype(eclass_t *record, etag_t *tag, ebool_t define,
	  esymbol_t *name, eobject_t list);

static void
function(eclass_t *record, etag_t *tag, esymbol_t *name,
	 eobject_t list, eobject_t code);

static void
return_statement(eobject_t list);

static void
record_statement(etoken_t token, eobject_t list);

static void
declaration(etag_t *tag, eobject_t list);

static void
typedef_statement(etag_t *tag, eobject_t list);

static void
try_statement(eobject_t list);

static void
throw_statement(eobject_t list);

static void
ctor_statement(eobject_t list);

/*
 * Initialization
 */
static evector_t	 *code_root;

efunction_t		*fn_root;
efunction_t		*fn_current;

static eblock_t		*code_block;
static ehash_t		*ht_literal;

static evector_t	*block_vector;
static eint32_t		 branch_nest;

static note_t		*note;
static evector_t	*note_name;
static eint32_t		 note_line;

/*
 * Implementation
 */
void
init_code(void)
{
   eobject_t		*root;

    evector(&code_root, t_void, 4, 1);
    eadd_root((eobject_t *)&code_root);
    root = code_root->v.ptr;

    root[0] = fn_current = fn_root = enew_function(false, null);

    enew_hash((eobject_t *)&ht_literal, H_string, 31);
    root[1] = ht_literal;

    /* bypass new_block so that gc does not need to be disabled
     * at startup (actually it is) */
    enew(&code_block, block);
    root[2] = code_block;
    code_block->token = tok_function;

    evector(&block_vector, t_void, 16, 1);
    root[3] = block_vector;
}

void
finish_code(void)
{
    assert(code_block && !code_block->parent &&
	   !code_block->t_jump && !code_block->f_jump);
    erem_root((eobject_t *)&code_root);
}

void
ecode(void)
{
    etag_t		*tag;
    east_list_t		*list;
    east_list_t		*next;
    eint32_t		 type;
    eint32_t		 offset;
    eobject_t	   	 object;
    erecord_t		*record;
    esymbol_t		*symbol;

#if defined(__linux__) && defined(__i386__)
    /*	double precision		0x200
     *	round nearest			0x000
     *	invalid operation mask		0x001
     *	denormalized operand mask	0x002
     *	zero divide mask		0x004
     *	precision (inexact) mask	0x020
     */
    fpu_control_t fpu_control = 0x027f;
    _FPU_SETCW(fpu_control);
    /*	linux default is to use extended precision 0x037f
     *	but the value being set here is to use 53 bits mantissa
     *	doubles, so that, values in registers actually fit in
     *	64 bits memory values
     */
#endif

#if 0	/* FIXME need to check arguments of round/ceil/floor */
    feenableexcept(FE_INVALID);
#endif

    /* reserve first offset for root code */
    ++ecs_idx;

    /* allocate temporary storage for intermediate function call information */
    init_function();

    while ((object = eparse()) != object_eof) {
	if (cfg_verbose > 2)
	    ewrite_parse(object);
	eeval(object);
    }
    east_link(ecode_simple(eop_exit));
    efinalize_function(fn_root);

    /* release temporary storage */
    finish_function();

    /* add initialization of statically typed globals, if any */
    next = null;
    for (offset = 0; offset < eds_idx; offset++) {
	symbol = eds[offset];
	if ((type = etag_packed_p(symbol->tag))) {
	    list = east_no_link(ecode_symbol_setup(symbol, type));
	    if (next == null)
		next = east_next(fn_current->code);
	    east_next(list) = east_next(next);
	    east_next(next) = list;
	    next = list;
	}
    }

    ecfg();

    memset(eds, 0, eds_len * sizeof(eobject_t));

    /* warn about types referenced but never defined, that is,
     * types that were only declared, but also an argument to
     * typeof or subtypeof, what caused a "type index" to be
     * allocated */
    for (offset = 0; offset < ht_language->size; offset++) {
	symbol = (esymbol_t *)ht_language->entries[offset];
	for (; symbol; symbol = symbol->next) {
	    if (symbol->a_type && (tag = symbol->value) &&
		(tag->type == tag_struct || tag->type == tag_class)) {
		record = (erecord_t *)tag->data;
		/* t_pointer is or'ed with an "open" type declaration */
		if ((record->type & t_pointer) && (record->type & ~t_pointer))
		    ewarn("type '%p' referenced but never defined",
			  symbol->name);
	    }
	}
    }

#if DEBUG
    vm_running = 1;
#endif

    init_vm();

    tmain->eip = ecs[0];
    evm(tmain);

#if DEBUG
    vm_running = 0;

    /* run gc before exit to trigger bad objects */
    egc();

    assert(tmain->ebp == tmain->ess &&
	   tmain->esp - fn_root->hash->offset == tmain->ess);
#endif
}

ebool_t
ecode_false_p(east_node_t *code)
{
    eobject_t	value;

    switch (code->code) {
	case eop_nil:
	    return (true);
	case eop_int:
	    return (immediate_int(code) == 0);
	case eop_float:
	    return (immediate_float(code) == 0);
	case eop_ll:
	    value = els[immediate_offset(code)];
	    if (etype(value) == t_mpr)
		return (mpfr_zero_p((empr_t)value));
	default:
	    return (false);
    }
}

east_list_t *
east_no_link(east_node_t *node)
{
    east_list_t			*ast;
    thread_self->obj		= node;
    enew(&ast, ast_list);
    east_node(ast)		= node;
    return (ast);
}

east_list_t *
east_label_no_link(east_node_t *node)
{
    east_list_t			*ast;
    ast				= east_no_link(node);
    elabel_list(node->clabel.label) = ast;
    return (ast);
}

east_list_t *
east_link(east_node_t *node)
{
    east_list_t			*ast;
    ast				= east_no_link(node);
    east_next(east_tail())	= ast;
    east_tail()			= ast;
    return (ast);
}

east_list_t *
east_label_link(east_node_t *node)
{
    east_list_t			*ast;
    ast				= east_link(node);
    elabel_list(node->clabel.label) = ast;
    return (ast);
}

east_node_t *
ecode_label(elabel_t *label)
{
    east_node_t			*node;
    enew(&node, code_label);
    node->code			= eop_label;
    node->clabel.label		= label;
    return (node);
}

east_node_t *
ecode_block(elabel_t *label)
{
    east_node_t			*node;
    enew(&node, code_label);
    node->code			= eop_block;
    node->clabel.label		= label;
    return (node);
}

east_node_t *
ecode_branch(ecode_t code, elabel_t *label)
{
    east_node_t			*node;
    enew(&node, code_label);
    node->code			= code;
    node->clabel.label		= label;
    /* remember this branch targets label */
    if (label)
	elabel_branch_insert(label, node);
    return (node);
}

east_node_t *
ecode_simple(ecode_t code)
{
    east_node_t			*node;
    enew(&node, code_simple);
    node->code			= code;
    return (node);
}

east_node_t *
ecode_symbol_load(esymbol_t *symbol)
{
    east_node_t			*node;
    enew(&node, code_symbol);
    node->code			= symbol->a_global ? eop_ld : eop_lb;
    if (symbol->type)		++node->code;
    node->csymbol.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_symbol_store(esymbol_t *symbol)
{
    east_node_t			*node;
    enew(&node, code_symbol);
    node->code			= symbol->a_global ? eop_sd : eop_sb;
    if (symbol->type)		++node->code;
    node->csymbol.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_symbol_pointer(esymbol_t *symbol)
{
    east_node_t			*node;
    enew(&node, code_symbol);
    node->code			= symbol->a_global ? eop_pd : eop_pb;
    if (symbol->type)		++node->code;
    node->csymbol.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_symbol_setup(esymbol_t *symbol, eint32_t type)
{
    east_node_t			*node;
    enew(&node, code_symbol);
    node->code			= eop_setup;
    node->csymbol.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_class(ecode_t code, esymbol_t *symbol)
{
    east_node_t			*node;
    enew(&node, code_symbol);
    node->code			= code;
    node->csymbol.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_hash(ecode_t code)
{
    east_node_t			*node;
    enew(&node, code_hash);
    node->code			= code;
    return (node);
}

east_node_t *
ecode_hash_ref(ecode_t code, eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_hash);
    node->code			= code;
    node->chash.arg		= arg;
    return (node);
}

east_node_t *
ecode_vector_new(eint32_t type, eint32_t rank)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_vnew;
    node->cvector.type		= type;
    node->cvector.rank		= rank;
    return (node);
}

east_node_t *
ecode_vector_renew(void)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_renew;
    return (node);
}

east_node_t *
ecode_vector_renew_static(eint32_t length)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_renewi;
    node->cvector.length	= length;
    return (node);
}

east_node_t *
ecode_vector_new_static(eint32_t type, eint32_t length, eint32_t rank,
			eobject_t *values)
{
    east_node_t			*node;
    eint32_t			 offset;
    enew_object((eobject_t *)&node, t_code_vector,
		sizeof(ecode_vector_t) - 4 + (rank << 2));
    node->code			= eop_vnewi;
    node->cvector.type		= type;
    node->cvector.length	= length;
    node->cvector.rank		= rank;
    for (offset = 0; offset < rank; offset++)
	node->cvector.dims[offset] = eget_fixnum(values[offset]);
    return (node);
}

east_node_t *
ecode_vector_copy(eint32_t length)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_vmv;
    node->cvector.length	= length;
    return (node);
}

east_node_t *
ecode_vector_load(eint32_t rank)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_lv;
    node->cvector.rank		= rank;
    return (node);
}

east_node_t *
ecode_vector_store(eint32_t rank)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_sv;
    node->cvector.rank		= rank;
    return (node);
}

east_node_t *
ecode_vector_pointer(eint32_t rank)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_pv;
    node->cvector.rank		= rank;
    return (node);
}

east_node_t *
ecode_vector_offset(eint32_t rank)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_off;
    node->cvector.rank		= rank;
    return (node);
}

east_node_t *
ecode_vector_load_static(eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_lvi;
    node->cvector.offset	= offset;
    return (node);
}

east_node_t *
ecode_vector_store_static(eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_svi;
    node->cvector.offset	= offset;
    return (node);
}

east_node_t *
ecode_vector_pointer_static(eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_pvi;
    node->cvector.offset	= offset;
    return (node);
}

east_node_t *
ecode_vector_load_ref(eint32_t rank, eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_lvref;
    node->cvector.rank		= rank;
    node->cvector.arg		= arg;
    return (node);
}

east_node_t *
ecode_vector_store_ref(eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_svref;
    node->cvector.arg		= arg;
    return (node);
}

east_node_t *
ecode_vector_sizeof(void)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_szof;
    return (node);
}

east_node_t *
ecode_vector_sizeofdim(void)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_szofdim;
    return (node);
}

east_node_t *
ecode_vector_sizeofdim_static(eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_vector);
    node->code			= eop_szofdimi;
    node->cvector.arg		= arg;
    return (node);
}

east_node_t *
ecode_record_new(erecord_t *record)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_new;
    node->crecord.record	= record;
    return (node);
}

east_node_t *
ecode_record_new_anon(erecord_t *record)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_anon;
    node->crecord.record	= record;
    return (node);
}

east_node_t *
ecode_record_copy(erecord_t *record)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_mv;
    node->crecord.record	= record;
    return (node);
}

east_node_t *
ecode_record(ecode_t code, erecord_t *record, esymbol_t *symbol)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= code;
    node->crecord.record	= record;
    node->crecord.symbol	= symbol;
    return (node);
}

east_node_t *
ecode_record_load_ref(erecord_t *record, esymbol_t *symbol, eint32_t arg)
{
    east_node_t			*node;
    node = ecode_record(eop_lrref, record, symbol);
    node->crecord.arg		= arg;
    return (node);
}

east_node_t *
ecode_record_store_ref(eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_srref;
    node->crecord.arg		= arg;
    return (node);
}

east_node_t *
ecode_record_typeof(void)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_tpof;
    return (node);
}

east_node_t *
ecode_record_subtypeof(void)
{
    east_node_t			*node;
    enew(&node, code_record);
    node->code			= eop_subtpof;
    return (node);
}

east_node_t *
ecode_enter_init(void)
{
    east_node_t				*node;
    enew(&node, code_enter);
    node->code				= eop_enter;
    return (node);
}

east_node_t *
ecode_enter_finish(efunction_t *function)
{
    esymbol_t		*atom;
    ehash_t		*hash;
    east_list_t		*list;
    east_node_t		*node;
    eint32_t		*types;
    eint32_t		 length;
    eint32_t		 offset;
    eint32_t		 acount;
    eint32_t		 lcount;
    evector_t		*vtypes;
    v_check(1);
    hash = function->hash;
    evector(&vtypes, t_int32, hash->count, 1);
    v_push(vtypes);
    types = vtypes->v.i32;
    for (length = 0; length < hash->size; length++) {
	for (atom = (esymbol_t *)hash->entries[length];
	     atom; atom = atom->next) {
	    if (atom->offset < 0)
		offset = -atom->offset - 2;
	    else
		offset = function->args + atom->offset - 1;
	    types[offset] = etag_packed_p(atom->tag);
	}
    }
    /* first entry is setup basic block and second is enter reserved slot */
    list = east_next(function->code);
    node = east_node(list);
    length = function->args;
    while (length > 0 && types[length - 1] == t_void)
	--length;
    acount = length;
    length = hash->count;
    while (length > function->args && types[length - 1] == t_void)
	--length;
    lcount = length - function->args;
    offset = function->hash->offset;
    length = function->stack - offset;
    if (offset == 0 && length == 0 && acount == 0 && lcount == 0)
	east_next(function->code) = east_next(list);
    else {
	if (acount || lcount) {
	    enew_object((eobject_t *)&node, t_code_enter,
			sizeof(ecode_enter_t) - 4 + ((acount + lcount) << 2));
	    east_node(list)		= node;
	    node->code			= eop_enter;
	}
	node->center.local		= offset;
	node->center.extra		= length;
	node->center.acount		= acount;
	node->center.lcount		= lcount;
	for (offset = 0; offset < acount; offset++)
	    node->center.types[offset]	= types[offset];
	types += function->args;
	for (length = offset, offset = 0; offset < lcount; offset++, length++)
	    node->center.types[length]	= types[offset];
    }
    v_dec();
    return (null);
}

east_node_t *
ecode_stack_push(ecode_t code, etag_t *tag, eint32_t hint)
{
    east_node_t			*node;
    enew(&node, code_stack);
    if ((node->cstack.type	= etag_packed_p(tag)))
	node->code		= eop_pusht;
    else
	node->code		= code;
    node->cstack.tag		= tag;
    node->cstack.flags		= hint;
    return (node);
}

east_node_t *
ecode_stack_load(eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_stack);
    node->code			= eop_ls;
    node->cstack.offset		= offset;
    return (node);
}

east_node_t *
ecode_stack_store_tag(eint32_t offset, etag_t *tag)
{
    east_node_t			*node;
    enew(&node, code_stack);
    if ((node->cstack.type	= etag_packed_p(tag)))
	node->code		= eop_sst;
    else
	node->code		= eop_ss;
    node->cstack.offset		= offset;
    node->cstack.tag		= tag;
    return (node);
}

east_node_t *
ecode_stack_store_value(eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_stack);
    node->code			= eop_ssv;
    node->cstack.offset		= offset;
    return (node);
}

east_node_t *
ecode_stack_store_value_tag(eint32_t offset, etag_t *tag)
{
    east_node_t			*node;
    enew(&node, code_stack);
    if ((node->cstack.type	= etag_packed_p(tag)))
	node->code		= eop_sst;
    else
	node->code		= eop_ssv;
    node->cstack.offset		= offset;
    node->cstack.tag		= tag;
    return (node);
}

east_node_t *
ecode_stack_pop(void)
{
    east_node_t			*node;
    enew(&node, code_stack);
    node->code			= eop_pop;
    return (node);
}

east_node_t *
ecode_call(esymbol_t *symbol)
{
    east_node_t			*node;
    efunction_t			*lambda;
    lambda = symbol->value;
    enew(&node, code_apply);
    node->code			= eop_call;
    node->capply.offset		= symbol->offset;
    node->capply.length		= lambda->args;
    node->capply.symbol		= symbol;
    return (node);
}

east_node_t *
ecode_builtin(esymbol_t *symbol, eint32_t length)
{
    east_node_t			*node;
    enew(&node, code_apply);
    node->code			= eop_blt;
    node->capply.offset		= symbol->offset;
    node->capply.length		= length;
    node->capply.symbol		= symbol;
    return (node);
}

east_node_t *
ecode_apply(eint32_t length)
{
    east_node_t			*node;
    enew(&node, code_apply);
    node->code			= eop_apply;
    node->capply.length		= length;
    return (node);
}

east_node_t *
ecode_function(esymbol_t *symbol, eint32_t length, eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_apply);
    node->code			= eop_fref;
    node->capply.offset		= symbol->offset;
    node->capply.length		= length;
    node->capply.arg		= arg;
    node->capply.symbol		= symbol;
    return (node);
}

east_node_t *
ecode_method(ecode_t code, esymbol_t *symbol, eint32_t type)
{
    east_node_t			*node;
    efunction_t			*lambda;
    lambda = symbol->value;
    enew(&node, code_apply);
    node->code			= code;
    node->capply.offset		= symbol->offset;
    node->capply.length		= lambda->args;
    node->capply.type		= type;
    node->capply.symbol		= symbol;
    return (node);
}

east_node_t *
ecode_return(eint32_t length, etag_t *tag)
{
    east_node_t			*node;
    enew(&node, code_return);
    node->creturn.length	= length;
    if ((node->creturn.type	= etag_packed_p(tag))) {
	if (length > 1)
	    node->code		= eop_retit;
	else
	    node->code		= eop_rett;
    }
    else {
	if (length > 1)
	    node->code		= eop_reti;
	else
	    node->code		= eop_ret;
    }
    node->creturn.tag		= tag;
    return (node);
}

east_node_t *
ecode_vararg(ecode_t code, eint32_t length)
{
    east_node_t			*node;
    enew(&node, code_stack);
    node->code			= code;
    node->cstack.length		= length;
    return (node);
}

east_node_t *
ecode_vararg_static(ecode_t code, eint32_t length, eint32_t offset)
{
    east_node_t			*node;
    enew(&node, code_stack);
    node->code			= code;
    node->cstack.length		= length;
    node->cstack.offset		= offset;
    return (node);
}

east_node_t *
ecode_logic(ecode_t code)
{
    east_node_t			*node;
    enew(&node, code_logic);
    node->code			= code;
    return (node);
}

east_node_t *
ecode_except(ecode_t code)
{
    east_node_t			*node;
    enew(&node, code_except);
    node->code			= code;
    return (node);
}

east_node_t *
ecode_except_arg(ecode_t code, eint32_t arg)
{
    east_node_t			*node;
    enew(&node, code_except);
    node->code			= code;
    node->cexcept.arg		= arg;
    return (node);
}

extern east_node_t *
ecode_note(evector_t *name, eint32_t line)
{
    east_node_t			*node;
    enew(&node, code_note);
    node->code			= eop_note;
    node->cnote.name		= name;
    node->cnote.line		= line;
    return (node);
}

void
edefine_builtin(esymbol_t *symbol, void (*builtin)(eint32_t),
		eint32_t args, ebool_t varargs)
{
    efunction_t	*lambda;

    assert(ebs_idx <= most_positive_fix32);
    if (ebs_idx >= ebs_len) {
	ebs_len += 4096;
	eresize_object((eobject_t *)&ebs, ebs_len * sizeof(eobject_t));
    }
    ebs[ebs_idx] = builtin;
    symbol->a_global = symbol->a_builtin = true;
    enew(&lambda, function);
    lambda->name = symbol;
    symbol->value = lambda;
    lambda->args = args;
    if (varargs)
	lambda->voffset = -(lambda->args + 1);
    symbol->offset = ebs_idx++;
}

void
elabel_branch_remove(elabel_t *label, east_node_t *node)
{
    east_node_t		**nodes;
    evector_t		 *vector;
    eint32_t		  offset;

    vector = label->jumps;
    nodes = vector->v.obj;

    for (offset = vector->offset - 1; offset >= 0; offset--) {
	if (nodes[offset] == node) {
	    if (--vector->offset)
		nodes[offset] = nodes[vector->offset];
	    nodes[vector->offset] = null;
	    return;
	}
    }
    abort();
}

void
elabel_branch_insert(elabel_t *label, east_node_t *node)
{
    east_node_t		**nodes;
    evector_t		 *vector;

    vector = label->jumps;
    if (vector->offset >= vector->length) {
	/* fast/simple way to ensure node is gc protected */
	thread_self->obj = node;
	erenew_vector(vector, vector->length + 4);
    }
    nodes = vector->v.obj;
    nodes[vector->offset++] = node;
}

void
elabel_branch_switch(elabel_t *prev, elabel_t *next, east_node_t *node)
{
    east_node_t		**nodes;
    eint32_t		  offset;

    if (next->jumps->offset >= next->jumps->length)
	erenew_vector(next->jumps, next->jumps->length + 4);
    nodes = prev->jumps->v.obj;
    for (offset = prev->jumps->offset - 1; offset >= 0; offset--) {
	if (nodes[offset] == node) {
	    if (--prev->jumps->offset)
		nodes[offset] = nodes[prev->jumps->offset];
	    nodes[prev->jumps->offset] = null;
	    nodes = next->jumps->v.obj;
	    nodes[next->jumps->offset++] = node;
	    node->clabel.label = next;
	    return;
	}
    }
    abort();
}

elabel_t *
ecreate_label(efunction_t *function)
{
    elabel_t		 *label;
    evector_t		 *vector;
    elabel_t		**labels;

    vector = function->labels;
    if (vector->offset >= vector->length)
	erenew_vector(vector, vector->length + 8);
    labels = vector->v.obj;

    enew(&label, label);
    label->ident = vector->offset;
    labels[vector->offset++] = label;

    evector(&label->jumps, t_void, 4, 1);
    evector(&label->srcs, t_void, 4, 1);
    evector(&label->dsts, t_void, 4, 1);

    /* ssa bit vectors */
    enew_mpz_u((eobject_t *)&label->set, 0);
    enew_mpz_u((eobject_t *)&label->use, 0);
    enew_mpz_u((eobject_t *)&label->phi, 0);

    return (label);
}

void
eremove_label(efunction_t *function, elabel_t *label)
{
    evector_t	 *vector;
    elabel_t	**labels;

    vector = function->labels;
    labels = vector->v.obj;
    assert(label->ident >= 0 && label->ident < vector->length &&
	   labels[label->ident] == label);

    /* compact labels vector */
    if (--vector->offset) {
	labels[label->ident] = labels[vector->offset];
	labels[vector->offset]->ident = label->ident;
    }
    labels[vector->offset] = null;
}

eentry_t *
eannotation(eobject_t list)
{
    eentry_t	*entry;
    note_t	*chain;

    if (list && (entry = eget_hash(hash_annotation, list)))
	return (entry);

    for (entry = null, chain = note; chain; chain = chain->prev) {
	if ((entry = eget_hash(hash_annotation, chain->value)))
	    break;
    }

    return (entry);
}

etag_t *
eeval(eobject_t object)
{
    etag_t		*tag;
    evector_t		*name;
    eint32_t		 line;
    note_t		 chain;
    eentry_t		*entry;

    switch (etype(object)) {
	case t_symbol:
	    tag = esymbol_load(object);
	    break;
	case t_cons:
	    if ((entry = eget_hash(hash_annotation, object))) {
		line = eget_integer(ecar(entry->value));
		name = ecdr(entry->value);
		east_link(ecode_note(name, line));
		note_name = name;
		note_line = line;
	    }
	    chain.value = object;
	    chain.prev = note;
	    note = &chain;
	    etag_expression(object);
	    tag = apply(ecar(object), ecdr(object));
	    note = chain.prev;
	    break;
	default:
	    tag = eliteral(object);
	    break;
    }

    return (tag);
}

etag_t *
eliteral(eobject_t object)
{
    etag_t	*tag;
    etype_t	 type;
    eint32_t	 offset;

    if (object) {
	switch (type = etype(object)) {
	    case t_fixnum:
		tag = int_tag;
		east_link(ecode_int(eget_fixnum(object)));
		break;
	    case t_int:
		tag = int_tag;
		east_link(ecode_int(*(eint_t *)object));
		break;
	    case t_float:
		tag = float_tag;
		east_link(ecode_float(*(efloat_t *)object));
		break;
	    case t_mpz:				case t_mpq:
	    case t_mpr:				case t_cdd:
	    case t_cqq:				case t_mpc:
	    case t_hash:
		tag = null;
		offset = econstant(object);
		east_link(ecode_literal(offset));
		break;
	    default:
		if ((type & ~(t_const|t_vector)) >= ets_idx)
		    eparse_error(null, "internal error (invalid object)");
		tag = etag_object(object);
		offset = econstant(object);
		east_link(ecode_literal(offset));
		break;
	}
    }
    else {
	tag = void_tag;
	east_link(ecode_nil());
    }

    return (tag);
}

etag_t *
elanguage(etoken_t token, eobject_t list)
{
    etag_t	*tag;
    east_node_t	*node;
    eblock_t	*block;
    eentry_t	*entry;
    esymbol_t	*symbol;

    tag = void_tag;
    switch (token) {
	case tok_type:
	    eeval(ecar(list));
	    tag = ecadr(list);
	    break;
	case tok_this:
	    if (list == null) {
		if (fn_current->record == null)
		    eparse_error(null, "'this' must be used in class methods");
		east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
							symbol_this->name)));
	    }
	    else
		eclass_load(ecar(list));
	    break;
	case tok_FUNCTION:
	    tag = eliteral(fn_current->name ? fn_current->name->name : null);
	    break;
	case tok_struct:
	case tok_class:
	case tok_union:
	    record_statement(token, list);
	    break;
	case tok_code:
	case tok_progn:
	    statement(list);
	    break;
	case tok_data:
	    tag = edata(list);
	    break;
	case tok_ternary:
	    tag = ternary_statement(list);
	    break;
	case tok_if:
	    if_statement(list);
	    break;
	case tok_while:
	    while_statement(list);
	    break;
	case tok_for:
	    for_statement(list);
	    break;
	case tok_do:
	    do_statement(list);
	    break;
	case tok_switch:
	    switch_statement(list);
	    break;
	case tok_case:
	    case_label(list);
	    break;
	case tok_default:
	    default_label();
	    break;
	case tok_list:
	    statement(list);
	    break;
	case tok_break:
	    for (block = code_block;
		 block;
		 block = block->parent) {
		if (block->token == tok_switch ||
		    ekind_of(block->token) == tok_loop)
		    break;
		if (block->token == tok_try)
		    /* FIXME adding 'eop_unwind,0' before the jump
		     * should be enough, but needs testing
		     */
		    eparse_error(null, "'break' in 'try' is not allowed");
		if (block->token == tok_function)
		    goto break_fail;
	    }
	    if (block == null)
	    break_fail:
		eparse_error(null, "'break' not in 'switch' or loop");
	    node = ecode_branch(eop_j, null);
	    east_link(node);
	    add_f_jump(block, node);
	    break;
	case tok_continue:
	    for (block = code_block;
		 block;
		 block = block->parent) {
		if (ekind_of(block->token) == tok_loop)
		    break;
		if (block->token == tok_try)
		    /* FIXME adding 'eop_unwind,0' before the jump
		     * should be enough, but needs testing
		     */
		    eparse_error(null, "'continue' in 'try' is not allowed");
		if (block->token == tok_function)
		    goto continue_fail;
	    }
	    if (block == null)
	    continue_fail:
		eparse_error(null, "'continue' not in loop");
	    east_link(ecode_branch(eop_j, block->label));
	    break;
	case tok_goto:
	    symbol = ecar(list);
	    if (!esymbol_p(symbol))
		eparse_error(null, "'goto' target is not a symbol");
	    if ((entry = eget_hash(fn_current->table, symbol)) == null) {
		/* forwared defined label */
		v_check(1);
		enew(&entry, entry);
		v_push(entry);
		entry->name = symbol;
		entry->value = econs_nil(ecreate_label(fn_current));
		eput_hash(fn_current->table, entry);
		v_dec();
	    }
	    east_link(ecode_branch(eop_j, ecar(entry->value)));
	    fn_current->gotos = econs(econs(symbol, code_block),
				      fn_current->gotos);
	    keep_block(code_block, block_has_goto);
	    break;
	case tok_label:
	    symbol = ecar(list);
	    if (!esymbol_p(symbol))
		eparse_error(null, "label identifier is not a symbol");
	    if ((entry = eget_hash(fn_current->table, symbol)) == null) {
		/* first time label is referenced */
		v_check(1);
		enew(&entry, entry);
		v_push(entry);
		entry->name = symbol;
		entry->value = econs(ecreate_label(fn_current), code_block);
		eput_hash(fn_current->table, entry);
		v_dec();
	    }
	    else if (ecdr(entry->value))
		eparse_error(null, "duplicated label '%p'", symbol->name);
	    erplacd(entry->value, code_block);
	    /* label is "defined" */
	    east_label_link(ecode_label(ecar(entry->value)));
	    keep_block(code_block, block_has_label);
	    break;
	case tok_return:
	    return_statement(list);
	    break;
	case tok_andand:	case tok_oror:
	    cond_expression(token, list);
	    tag = null;
	    break;
	case tok_set:
	    tag = set_expression(list);
	    break;
	case tok_andset ... tok_remset:
	    tag = setop_expression((token - tok_andset) + eop_and, list);
	    break;
	case tok_ne ... tok_complex:
	    tag = binary_expression((token - tok_ne) + eop_ne, list);
	    break;
	case tok_inc...tok_dec:
	    tag = incdec_expression((token - tok_inc) + eop_inc,
				    ecar(list), false);
	    break;
	case tok_not...tok_log10:
	    tag = unary_expression((token - tok_not) + eop_not, list);
	    break;
	case tok_postinc...tok_postdec:
	    tag = incdec_expression((token - tok_postinc) + eop_inc,
				    ecar(list), true);
	    break;
	case tok_vector:
	    tag = evector_load(list);
	    break;
	case tok_field:
	    tag = estruct_load(list);
	    break;
	case tok_new:
	    tag = new_expression(list);
	    break;
	case tok_rankof:
	    tag = rankof_expression(list);
	    break;
	case tok_sizeof:
	    tag = sizeof_expression(list);
	    break;
	case tok_typeof:
	    tag = typeof_expression(list);
	    break;
	case tok_subtypeof:
	    tag = subtypeof_expression(list);
	    break;
	case tok_renew:
	    tag = renew_expression(list);
	    break;
	case tok_pointer:
	    tag = epointer_load(list);
	    break;
	case tok_address:
	    tag = eaddress_load(list);
	    break;
	case tok_typedef:
	    typedef_statement(ecar(list), ecdr(list));
	    break;
	case tok_ellipsis:
	    eparse_error(null, "unexpected '...'");
	case tok_explicit:
	    eeval(ecar(list));
	    /* `this' pointer is in r0 */
	    list = ecdadr(list);
	    tag = eapply_method(true, ecar(list), ecadr(list), ecddr(list));
	    break;
	case tok_try:
	    try_statement(list);
	    break;
	case tok_throw:
	    throw_statement(list);
	    break;
	case tok_ctor:
	    ctor_statement(list);
	    break;
	default:
	    eparse_error(null, "internal error (invalid token)");
	    break;
    }

    return (tag);
}

void
evariable(ebool_t global, etag_t *tag, esymbol_t *symbol)
{
    eobject_t	object;

    if (global) {
	object = symbol;
	if ((symbol = eget_symbol(ht_root, symbol->name)) == null) {
	    symbol = enew_bound_symbol(object);
	    symbol->a_global = true;

	add_global:
	    symbol->offset = ht_root->offset++;
	    if (eds_idx >= eds_len) {
		eds_len += 4096;
		eresize_object((eobject_t *)&eds, eds_len * sizeof(eobject_t));
	    }
	    eds[eds_idx++] = symbol;
	}
	else if (symbol->tag != tag)
	    eparse_error(null, "symbol '%p' type mismatch", symbol->name);
	else if (symbol->a_symbol)
	    eparse_error(null, "symbol '%p' redeclared", symbol->name);
	else if (symbol->offset < 0)
	    goto add_global;
    }
    else {
	symbol = enew_bound_symbol(symbol);
	symbol->offset = ht_current->offset++;
    }

    symbol->tag = tag;
    symbol->type = etag_packed_p(tag);

    assert(symbol->offset <= most_positive_fix32);
    symbol->a_symbol = true;
}

eint32_t
econstant(eobject_t object)
{
    etype_t	 type;
    eentry_t	*entry;
    eobject_t	 value;
    evector_t	*vector;
    v_enter();

    assert(els_idx <= most_positive_fix32);
    if (els_idx >= els_len) {
	els_len += 4096;
	eresize_object((eobject_t *)&els, els_len * sizeof(eobject_t));
    }

    switch ((type = etype(object))) {
#if DEBUG
	case t_void:		case t_fixnum:		case t_int:
	case t_float:
	    assert(type == t_void || type == t_fixnum ||
		   type == t_int || type == t_float);
#endif
	case t_mpz:		case t_mpq:		case t_mpr:
	case t_cdd:		case t_cqq:		case t_mpc:
	    if ((entry = eget_hash(ht_literal, object)))
		break;
	case t_hash:
	    value = object;
	    goto create;

	case t_const_string:
	    vector = object;
	    if ((entry = eget_hash(ht_literal, vector->v.obj)))
		break;
	    value = object;
	    object = vector->v.obj;
	    goto create;
	default:
	    value = object;
	    /* ensure that the same object is not stored more then once */
	    if (!evector_type_p(type)) {
		v_check(1);
		enew_object((eobject_t *)&vector, t_void, sizeof(eobject_t));
		v_push(vector);
		vector->v.obj = object;
		object = vector;
	    }
	    if ((entry = eget_hash(ht_literal, object)))
		break;
	create:
	    enew(&entry, entry);
	    entry->name = object;
	    entry->value = efixnum(els_idx);
	    eput_hash(ht_literal, entry);
	    els[els_idx++] = value;
	    break;
    }

    v_leave();
    return (eget_fixnum(entry->value));
}

static eblock_t *
new_block(etoken_t token)
{
    eblock_t	**pool;
    eblock_t	 *block;

    pool = block_vector->v.obj;
    if ((block = pool[block_vector->offset]) == null)
	enew(&block, block);

    /* gc protect */
    block->parent = code_block;
    code_block = block;
    block->token = token;

    return (block);
}

static void
del_block(void)
{
    eblock_t	**pool;

    /* do not reuse blocks that should be kept alive, and are gc
     * protected, as their information will be used to validate
     * gotos at the end of the function */
    if (!code_block->flags) {
	/* keep one free slot so to simplify enew_block() */
	if (block_vector->offset + 1 >= block_vector->length)
	    erenew_vector(block_vector,
			  (block_vector->length + 16) & ~15);
	pool = block_vector->v.obj;
	pool[block_vector->offset++] = code_block;
    }
    code_block->table = null;
    code_block->label = null;
    assert((!code_block->t_jump || !code_block->t_jump->offset) &&
	   (!code_block->f_jump || !code_block->f_jump->offset));
    code_block = code_block->parent;
}

static void
keep_block(eblock_t *block, eint32_t flags)
{
    while (block) {
	if ((block->flags & flags) == flags)
	    break;
	block->flags |= flags;
	if (block->token == tok_function)
	    break;
	block = block->parent;
    }
}

static void
add_t_jump(eblock_t *block, east_node_t *node)
{
    east_node_t	**jumps;

    assert(node->clabel.label == null);
    if (block->t_jump == null)
	evector(&block->t_jump, t_void, 4, 1);
    else if (block->t_jump->offset >= block->t_jump->length)
	erenew_vector(block->t_jump, block->t_jump->length + 4);
    jumps = block->t_jump->v.obj;
    jumps[block->t_jump->offset++] = node;
}

static void
add_f_jump(eblock_t *block, east_node_t *node)
{
    east_node_t	**jumps;

    assert(node->clabel.label == null);
    if (block->f_jump == null)
	evector(&block->f_jump, t_void, 4, 1);
    else if (block->f_jump->offset >= block->f_jump->length)
	erenew_vector(block->f_jump, block->f_jump->length + 4);
    jumps = block->f_jump->v.obj;
    jumps[block->f_jump->offset++] = node;
}

static void
patch_jump(elabel_t *label, east_node_t *node)
{
    assert(node->clabel.label == null);
    node->clabel.label = label;
    elabel_branch_insert(label, node);
}

static etag_t *
apply(eobject_t object, eobject_t list)
{
    etag_t	*tag;
    esymbol_t	*symbol;

    switch (etype(object)) {
	case t_fixnum:
	    tag = elanguage(eget_fixnum(object), list);
	    break;
	case t_symbol:
	    symbol = eget_bound_symbol(object);
	    if (symbol->a_method)
		tag = eapply_method(false, this_obj, symbol, list);
	    else
		tag = eapply_function(eget_bound_symbol(object), list);
	    break;
	case t_cons:
	    if (!efixnum(ecar(object)))
		goto apply_fail;
	    switch (eget_fixnum(ecar(object))) {
		case tok_this:
		    tag = eapply_method(false, this_obj, ecadr(object), list);
		    break;
		case tok_field:
		    object = ecdr(object);
		    tag = eapply_method(false, ecar(object),
					ecadr(object), list);
		    break;
		case tok_pointer:
		    tag = eapply_reference(ecadr(object), list);
		    break;
		default:
		apply_fail:
		    eparse_error(null, "object is not a function");
	    }
	    break;
	case t_tag:
	case t_void:
	    declaration(object, list);
	    tag = null;
	    break;
	default:
	    eparse_error(null, "expecting expression");
	    break;
    }

    return (tag);
}

static etag_t *
statement(eobject_t list)
{
    etag_t	*tag;

    for (tag = null; list; list = ecdr(list))
	tag = eeval(ecar(list));

    return (tag);
}

static etag_t *
ternary_statement(eobject_t list)
{
    etag_t		 *tag;
    etag_t		 *etag;
    east_node_t		 *node;
    eblock_t		 *block;
    elabel_t		 *label;
    east_node_t		**jumps;

    /* evaluate test condition */
    block = new_block(tok_ternary);
    eeval(ecar(list));
    if (!block->f_jump || !block->f_jump->offset) {
	node = ecode_branch(eop_jf, null);
	east_link(node);
	add_f_jump(block, node);
    }

    /* patch true condition jumps */
    if (block->t_jump && block->t_jump->offset) {
	jumps = block->t_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->t_jump->offset]);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }
    list = ecdr(list);

    /* true condition code */
    tag = eeval(ecar(list));

    /* jump over false condition code */
    node = ecode_branch(eop_j, null);
    east_link(node);

    /* patch false condition jumps */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    /* false condition code */
    etag = eeval(ecadr(list));
    label = ecreate_label(fn_current);
    east_label_link(ecode_label(label));
    patch_jump(label, node);
    if (tag && etag && tag != etag)
	eparse_warn(null, "different ternary types");

    del_block();

    return (tag);
}

static void
if_statement(eobject_t list)
{
    east_node_t		 *node;
    eobject_t		 *test;
    eblock_t		 *block;
    elabel_t		 *label;
    east_node_t		**jumps;

    test = ecar(list);
    for (; ecdr(test); test = ecdr(test))
	eeval(ecar(test));
    test = ecar(test);

    /* evaluate test condition */
    block = new_block(tok_if);
    eeval(test);
    if (!block->f_jump || !block->f_jump->offset) {
	node = ecode_branch(eop_jf, null);
	east_link(node);
	add_f_jump(block, node);
    }

    /* patch true condition jumps */
    if (block->t_jump && block->t_jump->offset) {
	jumps = block->t_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->t_jump->offset]);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }
    list = ecdr(list);

    /* true condition code */
    eeval(ecar(list));

    /* check if need to jump over false condition code */
    if ((list = ecdr(list))) {
	node = ecode_branch(eop_j, null);
	east_link(node);
    }
    else
	node = null;

    /* patch false condition jumps */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    /* false condition code */
    if (list) {
	eeval(ecar(list));
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	patch_jump(label, node);
    }

    del_block();
}

static void
while_statement(eobject_t list)
{
    eobject_t		  cons;
    east_node_t		 *node;
    eobject_t		  test;
    eblock_t		 *block;
    elabel_t		 *label;
    east_node_t		**jumps;

    test = ecar(list);
    list = ecdr(list);

    /* unroll first test */
    for (cons = test; ecdr(cons); cons = ecdr(cons))
	eeval(ecar(cons));

    block = new_block(tok_while);
    eeval(ecar(cons));
    if (!block->f_jump || !block->f_jump->offset) {
	node = ecode_branch(eop_jf, null);
	east_link(node);
	add_f_jump(block, node);
    }

    /* loop restart point */
    label = ecreate_label(fn_current);
    east_label_link(ecode_label(label));

    /* patch true condition jumps */
    if (block->t_jump && block->t_jump->offset) {
	jumps = block->t_jump->v.obj;
	do {
	    patch_jump(label, jumps[--block->t_jump->offset]);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }

    /* create continue label */
    block->label = ecreate_label(fn_current);

    /* execute body */
    eeval(ecar(list));

    /* continue target */
    east_label_link(ecode_label(block->label));

    /* reevaluate test */
    for (cons = test; ecdr(cons); cons = ecdr(cons))
	eeval(ecar(cons));
    ++branch_nest;
    eeval(ecar(cons));
    --branch_nest;
    /* jump back to start of loop */
    if (!block->t_jump || !block->t_jump->offset)
	east_link(ecode_branch(eop_jt, label));
    else {
	jumps = block->t_jump->v.obj;
	do {
	    patch_jump(label, jumps[--block->t_jump->offset]);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }

    /* exit loop */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    del_block();
}

static void
for_statement(eobject_t list)
{
    eobject_t		  cons;
    east_node_t		 *node;
    eobject_t		  test;
    eblock_t		 *block;
    elabel_t		 *label;
    east_node_t		**jumps;

    /* initialization done only once */
    statement(ecar(list));

    /* unroll first test */
    list = ecdr(list);
    if ((test = ecar(list))) {
	for (cons = test; ecdr(cons); cons = ecdr(cons))
	    eeval(ecar(cons));
    }
    else
	cons = null;

    block = new_block(tok_for);

    /* loop restart point */
    label = ecreate_label(fn_current);

    if (test) {
	eeval(ecar(cons));
	if (!block->f_jump || !block->f_jump->offset) {
	    node = ecode_branch(eop_jf, null);
	    east_link(node);
	    add_f_jump(block, node);
	}
	if (block->t_jump && block->t_jump->offset) {
	    jumps = block->t_jump->v.obj;
	    do {
		patch_jump(label, jumps[--block->t_jump->offset]);
		jumps[block->t_jump->offset] = null;
	    } while (block->t_jump->offset);
	}
    }

    /* loop restart point */
    east_label_link(ecode_label(label));

    /* create continue label */
    block->label = ecreate_label(fn_current);

    /* execute body */
    list = ecdr(list);
    eeval(ecadr(list));

    /* continue target */
    east_label_link(ecode_label(block->label));

    /* increment code */
    statement(ecar(list));

    /* reevaluate test */
    if (test) {
	eeval(ecar(cons));
	if (!block->t_jump || !block->t_jump->offset)
	    east_link(ecode_branch(eop_jt, label));
	else {
	    jumps = block->t_jump->v.obj;
	    do {
		patch_jump(label, jumps[--block->t_jump->offset]);
		jumps[block->t_jump->offset] = null;
	    } while (block->t_jump->offset);
	}
    }
    else {
	node = ecode_branch(eop_j, label);
	east_link(node);
    }

    /* exit loop */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    del_block();
}

static void
do_statement(eobject_t list)
{
    eblock_t		 *block;
    elabel_t		 *label;
    east_node_t		**jumps;

    block = new_block(tok_do);
    block->label = ecreate_label(fn_current);

    /* body */
    label = ecreate_label(fn_current);
    east_label_link(ecode_label(label));
    eeval(ecar(list));

    /* test */
    east_label_link(ecode_label(block->label));
    for (list = ecadr(list); ecdr(list); list = ecdr(list))
	eeval(ecar(list));
    eeval(ecar(list));
    if (!block->t_jump || !block->t_jump->offset)
	east_link(ecode_branch(eop_jt, label));
    else {
	jumps = block->t_jump->v.obj;
	do {
	    patch_jump(label, jumps[--block->t_jump->offset]);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }

    /* exit loop */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    del_block();
}

static void
switch_finalize(eblock_t *block, east_list_t *test, east_list_t *done,
		eentry_t *entry)
{
    east_node_t		 *node;
    ehash_t		 *hash;
    east_node_t		 *jump;
    east_node_t		**jumps;
    elabel_t		 *label;
    eint32_t		  offset;

    hash = block->table;
    /* if there is at least one 'case' label */
    if (hash->count) {
	/* remember this branch targets label */
	node = east_node(done);
	elabel_branch_insert(node->clabel.label, node);

	/* did not know the offset until now */
	test = east_next(test);
	node = east_node(test);
	immediate_offset(node) = econstant(hash);
	/* default jump address if no case label.
	 * used to fill jump address if can generate
	 * a jump table without clashes */
	eput_hash(hash, entry);

	/* add entry for switch information to all label targets */
	for (offset = 0; offset < hash->size; offset++)
	    for (entry = hash->entries[offset]; entry; entry = entry->next) {
		/* remember this switch targets label */
		jump = entry->value;
		elabel_branch_insert(jump->clabel.label, node);
	    }
    }
    /* else don't waste a constant entry */
    else
	east_next(test) = east_next(done);

    /* exit switch block */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	label = ecreate_label(fn_current);
	east_label_link(ecode_label(label));
	do {
	    patch_jump(label, jumps[--block->f_jump->offset]);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }
}

static void
switch_statement(eobject_t list)
{
    eobject_t		 cons;
    east_node_t		*node;
    east_list_t		*done;
    east_list_t		*test;
    eblock_t		*block;
    eentry_t		*entry;
    v_enter();

    for (cons = ecar(list); ecdr(cons); cons = ecdr(cons))
	eeval(ecar(cons));

    block = new_block(tok_switch);
    enew_hash((eobject_t *)&block->table, H_string, 5);
    eeval(ecar(cons));

    /* add hash opcode, and remember about object, to add offset */
    test = east_tail();
    east_link(ecode_switch());

    /* reserve space for jump to default label or end of switch */
    node = ecode_branch(eop_j, null);
    east_link(node);
    done = east_tail();

    /* body */
    eeval(ecadr(list));

    /* if there is no default value */
    if (block->label == null) {
	block->label = ecreate_label(fn_current);
	east_label_link(ecode_label(block->label));
    }

    v_check(1);
    enew(&entry, entry);
    v_push(entry);
    entry->name = null;

    /* link exit point */
    node->clabel.label = block->label;
    entry->value = ecode_label(block->label);

    switch_finalize(block, test, done, entry);

    del_block();
    v_leave();
}

static void
case_add_label(ehash_t *hash, eobject_t object, ebool_t check)
{
    eobject_t	 label;
    eentry_t	*entry;

    if (check && eget_hash(hash, object))
	eparse_error(null, "duplicate 'case %p'", object);

    /* add one entry for actual tested value */
    enew(&entry, entry);
    entry->name = object;
    eput_hash(hash, entry);
    label = ecreate_label(fn_current);
    entry->value = ecode_label(label);
    east_label_link(ecode_label(label));
}

static void
case_label(eobject_t list)
{
    eint_t	 f, t;
    eblock_t	*block;
    eobject_t	 object;

    for (block = code_block;
	 block && block->token != tok_switch && block->token != tok_function;
	 block = block->parent)
	;
    if (block == null || block->token != tok_switch)
	eparse_error(null, "'case' not in 'switch'");
    v_check(1);
    v_push(null);
    /* FIXME add comparison code, or trigger error, if range is too large */
    if (econs_p(list)) {
	f = eget_integer(ecar(list));
	t = eget_integer(ecdr(list));
	if (f > t)
	    eparse_warn(null, "empty 'case %p ... %p'", ecar(list), ecdr(list));
	else {
	    case_add_label(block->table, ecar(list), true);
	    if (f < t) {
		for (++f; f < t; ++f) {
		    einteger(&object, f);
		    case_add_label(block->table, object, true);
		}
		case_add_label(block->table, ecdr(list), true);
	    }
	}
    }
    else
	case_add_label(block->table, list, true);
    v_dec();
}

static void
default_label(void)
{
    eblock_t	*block;

    for (block = code_block;
	 block && block->token != tok_switch && block->token != tok_function;
	 block = block->parent)
	;
    if (block == null || block->token != tok_switch)
	eparse_error(null, "'default' not in 'switch'");
    if (block->label)
	eparse_error(null, "duplicate 'default'");
    /* use test label field to store default address */
    block->label = ecreate_label(fn_current);
    east_label_link(ecode_label(block->label));
}

static etag_t *
set_expression(eobject_t list)
{
    etag_t	*tag;
    etag_t	*save;
    eobject_t	 value;

    save = data_tag;
    value = ecadr(list);
    list = ecar(list);
    data_tag = etag_expression(list);
    if (econs_p(list) && ecar(list) == efixnum(tok_type))
	list = ecadr(list);
    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_store(list, value);
	    break;
	case t_cons:
	    if (ecar(list) == efixnum(tok_this)) {
		if (list == this_obj)
		    eparse_error(list, "not a lvalue");
		tag = eclass_store(ecadr(list), value);
	    }
	    else
		tag = eobject_store(list, value);
	    break;
	default:
	    eparse_error(list, "not a lvalue");
    }
    data_tag = save;

    return (tag);
}

static etag_t *
setop_expression(ecode_t code, eobject_t list)
{
    etag_t	*tag;
    eobject_t	 value;

    value = ecadr(list);
    list = ecar(list);
    /* check list for unions */
    /* FIXME should handle it in the record code */
    tag = etag_expression(list);
    etag_expression(list);
    if (econs_p(list) && ecar(list) == efixnum(tok_type))
	list = ecadr(list);
    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_setop(list, value, code);
	    break;
	case t_cons:
	    if (ecar(list) == efixnum(tok_this)) {
		if (list == this_obj)
		    eparse_error(list, "not a lvalue");
		tag = eclass_setop(ecadr(list), value, code);
	    }
	    else
		tag = eobject_setop(list, value, code);
	    break;
	default:
	    eparse_error(list, "not a lvalue");
    }

    return (tag);
}

static etag_t *
incdec_expression(ecode_t code, eobject_t list, ebool_t post)
{
    etag_t	*tag;

    /* check list for unions */
    /* FIXME should handle it in the record code */
    tag = etag_expression(list);
    if (econs_p(list) && ecar(list) == efixnum(tok_type))
	list = ecadr(list);
    switch (etype(list)) {
	case t_symbol:
	    tag = esymbol_incdec(list, post, code);
	    break;
	case t_cons:
	    if (ecar(list) == efixnum(tok_this)) {
		if (list == this_obj)
		    eparse_error(null, "not a lvalue");
		tag = eclass_incdec(ecadr(list), post, code);
	    }
	    else
		tag = eobject_incdec(list, post, code);
	    break;
	default:
	    eparse_error(null, "not a lvalue");
    }

    return (tag);
}

static etag_t *
unary_expression(ecode_t code, eobject_t list)
{
    eeval(ecar(list));
    east_logic_link(ecode_unary(code));

    return (null);
}

static etag_t *
binary_expression(ecode_t code, eobject_t list)
{
    eeval(ecar(list));
    east_link(ecode_push_binarg());
    eeval(ecadr(list));
    east_logic_link(ecode_binary(code));

    return (null);
}

static void
cond_expression(etoken_t token, eobject_t list)
{
    east_node_t	 *node;
    elabel_t	 *label;
    east_node_t	**jumps;
    eblock_t	 *block;
    eblock_t	 *parent;

    parent = code_block;
    block = new_block(token);

    /* left expression */
    ++branch_nest;
    eeval(ecar(list));

    /* ensure expression result is 0 or 1 */
    switch (east_tail()->node->code) {
	case eop_jt:	case eop_jf:
	case eop_bool:	case eop_not:
	case eop_ne:	case eop_lt:	case eop_le:
	case eop_eq:	case eop_ge:	case eop_gt:
	    break;
	default:
	    east_logic_link(ecode_unary(eop_bool));
	    break;
    }

    if (token == tok_andand) {
	if (!block->f_jump || !block->f_jump->offset) {
	    node = ecode_branch(eop_jf, null);
	    east_link(node);
	    add_f_jump(block, node);
	}
    }
    else {
	assert(token == tok_oror);
	if (!block->t_jump || !block->t_jump->offset) {
	    node = ecode_branch(eop_jt, null);
	    east_link(node);
	    add_t_jump(block, node);
	}
    }

    /* adjust left true condition jumps */
    if (block->t_jump && block->t_jump->offset) {
	/* lift true test jumps down for ||, must check next test for && */
	jumps = block->t_jump->v.obj;
	if (token == tok_andand) {
	    label = ecreate_label(fn_current);
	    east_label_link(ecode_label(label));
	}
	else
	    label = null;
	if (token != tok_oror || branch_nest > 1) {
	    do {
		node = jumps[--block->t_jump->offset];
		if (token == tok_andand)
		    patch_jump(label, node);
		else
		    add_t_jump(parent, node);
		jumps[block->t_jump->offset] = null;
	    } while (block->t_jump->offset);
	}
    }

    /* adjust left false condition jumps */
    if (block->f_jump && block->f_jump->offset) {
	/* lift false test jumps down for &&, must check next test for || */
	jumps = block->f_jump->v.obj;
	if (token == tok_oror) {
	    label = ecreate_label(fn_current);
	    east_label_link(ecode_label(label));
	}
	else
	    label = null;
	if (token != tok_andand || branch_nest > 1) {
	    do {
		node = jumps[--block->f_jump->offset];
		if (token == tok_oror)
		    patch_jump(label, node);
		else
		    add_f_jump(parent, node);
		jumps[block->f_jump->offset] = null;
	    } while (block->f_jump->offset);
	}
    }

    /* right expression */
    eeval(ecadr(list));
    --branch_nest;

    /* ensure expression result is 0 or 1 */
    switch (east_tail()->node->code) {
	case eop_jt:	case eop_jf:
	case eop_bool:	case eop_not:
	case eop_ne:	case eop_lt:	case eop_le:
	case eop_eq:	case eop_ge:	case eop_gt:
	    break;
	default:
	    east_logic_link(ecode_unary(eop_bool));
	    break;
    }

    if (branch_nest) {
	if (token == tok_andand) {
	    if (!block->f_jump || !block->f_jump->offset) {
		node = ecode_branch(eop_jf, null);
		east_link(node);
		add_f_jump(parent, node);
	    }
	}
	else {
	    if (!block->t_jump || !block->t_jump->offset) {
		node = ecode_branch(eop_jt, null);
		east_link(node);
		add_t_jump(parent, node);
	    }
	}
    }

    /* adjust right true condition jumps */
    if (block->t_jump && block->t_jump->offset) {
	/* lift true test jumps down if nested,
	 * add label before true code if not nested */
	jumps = block->t_jump->v.obj;
	if (!branch_nest) {
	    label = ecreate_label(fn_current);
	    east_label_link(ecode_label(label));
	}
	else
	    label = null;
	do {
	    node = jumps[--block->t_jump->offset];
	    if (branch_nest)
		add_t_jump(parent, node);
	    else
		patch_jump(label, node);
	    jumps[block->t_jump->offset] = null;
	} while (block->t_jump->offset);
    }
    else
	label = null;

    /* adjust right false condition jumps */
    if (block->f_jump && block->f_jump->offset) {
	jumps = block->f_jump->v.obj;
	/* always lift down rigt false right expression unless
	 * not in toplevel branch expression */
	if (!branch_nest) {
	    label = ecreate_label(fn_current);
	    east_label_link(ecode_label(label));
	}
	else
	    label = null;
	do {
	    node = jumps[--block->f_jump->offset];
	    if (branch_nest)
		add_f_jump(parent, node);
	    else
		patch_jump(label, node);
	    jumps[block->f_jump->offset] = null;
	} while (block->f_jump->offset);
    }

    del_block();
}

static etag_t *
new_expression(eobject_t list)
{
    etag_t	*tag;
    eint32_t	 rank;
    etag_t	*save;
    eint32_t	 dims;
    etype_t	 type;
    eint32_t	 size;
    erecord_t	*record;
    eobject_t	*values;
    eint32_t	 dimension;
    list = ecar(list);
    switch (etype(list)) {
	case t_tag:
	    tag = list;
	    switch (tag->type) {
		case tag_union:
		    /* nothing done */
		    tag = null;
		    break;
		case tag_struct:
		case tag_class:
		    record = tag->data;
		    east_link(ecode_record_new(record));
		    if (tag->type == tag_class &&
			eget_symbol(record->methods, symbol_new->name) != null)
			/* call constructor */
			eapply_method(true, tag, symbol_new, null);
		    break;
		case tag_vector:
		    values = tag->data;
		    /* check base data type for array/vector */
		    record = null;
		    if (values[0]) {
			record = ((etag_t *)values[0])->data;
			/* if a "complex" data type vector */
			if (!ebasic_p(record))
			    record = null;
		    }
		    dims = (eobject_length(values) / sizeof(eobject_t)) - 1;
		    ++values;
		    for (rank = 0, size = 1; rank < dims; rank++) {
			if ((dimension = eget_fixnum(values[rank])) == 0) {
			    if (rank + 1 == dims && dims)
				break;
			    eparse_error(list, "cannot instantiate array");
			}
			size *= dimension;
		    }
		    if (rank == dims && record)
			type = t_vector | record->type;
		    else
			type = t_vector;
		    east_link(ecode_vector_new_static(type, size, rank, values));
		    break;
		case tag_hashtable:
		    eparse_error(list, "opaque types must call constructor");
		default:
		    goto new_fail;
	    }
	    break;
	case t_cons:
	    if (!efixnum_p(ecar(list)))
		eparse_error(list, "expecting expression");
	    switch (eget_fixnum(ecar(list))) {
		case tok_new_type_data:
		    save = data_tag;
		    data_tag = ecadr(list);
		    tag = edata(ecddr(list));
		    data_tag = save;
		    break;
		case tok_vector:
		    tag = new_vector(ecdr(list));
		    break;
		default:
		    eparse_error(list, "expecting expression");
		    break;
	    }
	    break;
	default:
	new_fail:
	    eparse_error(null, "expecting type");
    }

    return (tag);
}

static etag_t *
new_vector(eobject_t list)
{
    etag_t	*tag;
    eint32_t	 rank;
    eobject_t	 cons;
    eint32_t	 dims;
    eint32_t	 size;
    etype_t	 type;
    eint32_t	 check;
    erecord_t	*record;

    /* elements type and size */
    type = t_void;
    tag = ecar(list);
    if (etag_p(tag)) {
	switch (tag->type) {
	    case tag_void:
		eparse_error(null, "'void' cannot be instantiated");
	    case tag_basic:
		record = tag->data;
		type = record->type;
		break;
	    case tag_struct:
	    case tag_class:
		record = tag->data;
		type = record->type;
	    default:
		break;
	}
    }
    else if (tag)
	eparse_error(null, "expecting type");
    /* vector length */
    list = ecdr(list);
    if ((dims = elength(list)) == 0)
	eparse_error(null, "must specify length");

    /* check if all dimensions are constant */
    for (rank = 0, size = 1, cons = list;
	 cons && efixnum_p(ecar(cons));
	 cons = ecdr(cons), rank++) {
	check = size;
	size *= eget_fixnum(ecar(cons));
	if (size < check)
	    eparse_error(null, "array too large");
    }

    if (rank == dims) {
	/* constant dimensions */
	tag = etag_vector(tag, list);
	east_link(ecode_vector_new_static(t_vector | type, size, rank,
					  (eobject_t *)tag->data + 1));
    }
    else {
	/* dynamic dimensions */
	if (!etag_number_p(eeval(ecar(list))))
	    eparse_error(null, "invalid offset");
	for (rank = 1, list = ecdr(list); list; list = ecdr(list), rank++) {
	    east_link(ecode_push());
	    if (!etag_number_p(eeval(ecar(list))))
		eparse_error(null, "invalid offset");
	}
	east_link(ecode_vector_new(t_vector | type, rank));
	tag = etag_vector(tag, null);
    }

    return (tag);
}

static etag_t *
rankof_expression(eobject_t list)
{
    etype_t	 type;
    eobject_t	 object;
    evector_t	*vector;
    eobject_t	 integer;

    object = ecar(list);
    if (object == ellipsis_obj) {
	if (fn_current == fn_root || !fn_current->voffset)
	    eparse_error(null, "function is not vararg");
	eliteral(efixnum(1));
    }
    else {
	type = etype(object);
	if ((type & (t_const|t_vector|t_pointer)) == (t_const|t_vector)) {
	    vector = object;
	    einteger(&integer, vector->rank);
	    eliteral(integer);
	}
	else if (evector_type_p(type) || type == t_cons || type == t_symbol) {
	    eeval(object);
	    east_link(ecode_simple(eop_rankof));
	}
	else if (type == t_fixnum || type < ets_idx)
	    eliteral(efixnum(0));
	else
	    eparse_error(null, "expecting expression");
    }

    return (int_tag);
}

static etag_t *
sizeof_expression(eobject_t list)
{
    etype_t	 type;
    eobject_t	 object;
    evector_t	*vector;
    eobject_t	 integer;

    object = ecar(list);
    if (object == ellipsis_obj) {
	if (fn_current == fn_root || !fn_current->voffset)
	    eparse_error(null, "function is not vararg");
	if (ecdr(list))
	    eparse_error(null, "varargs have only one dimension");
	east_link(ecode_simple(eop_szofva));
    }
    else {
	type = etype(object);
	if ((type & (t_const|t_vector|t_pointer)) == (t_const|t_vector)) {
	    vector = object;
	    if (ecdr(list)) {
		integer = ecadr(list);
		if (integer == null || efixnum_p(integer)) {
		    type = eget_fixnum(integer);
		    if ((euint32_t)type < vector->rank)
			einteger(&integer, vector->dims[type].dim);
		    else
			integer = efixnum(0);
		    eliteral(integer);
		}
		else {
		    eliteral(object);
		    east_link(ecode_push());
		    east_link(ecode_vector_sizeofdim());
		}
	    }
	    else {
		einteger(&integer, vector->length);
		eliteral(integer);
	    }
	}
	else if (evector_type_p(type) || type == t_cons || type == t_symbol) {
	    eeval(object);
	    if (ecdr(list)) {
		integer = ecadr(list);
		if (integer == null || efixnum_p(integer))
		    east_link(ecode_vector_sizeofdim_static(eget_fixnum(integer)));
		else {
		    east_link(ecode_push());
		    eeval(integer);
		    east_link(ecode_vector_sizeofdim());
		}
	    }
	    else
		east_link(ecode_vector_sizeof());
	}
	else if (type == t_fixnum || type < ets_idx)
	    eliteral(efixnum(0));
	else
	    eparse_error(null, "expecting expression");
    }

    return (int_tag);
}

static etag_t *
typeof_expression(eobject_t list)
{
    eobject_t	 object;
    eobject_t	 integer;

    object = ecar(list);
    if (object == null || etag_p(object)) {
	einteger(&integer, etag_to_integer(object));
	eliteral(integer);
    }
    else {
	switch (etype(object)) {
	    case t_fixnum:
	    case t_int:
	    case t_float:
	    case t_string:
		einteger(&integer, etag_to_integer(etag_object(object)));
		eliteral(integer);
		break;
	    default:
		eeval(object);
		east_link(ecode_record_typeof());
	}
    }

    return (int_tag);
}

static etag_t *
subtypeof_expression(eobject_t list)
{
    etag_t	*ctag;
    etag_t	*ttag;
    eobject_t	 cons;
    eobject_t	 type;
    erecord_t	*record;

    cons = ecar(list);
    list = ecdr(list);
    type = ecar(list);

    if (cons == null || type == null)
	goto fail;

    ctag = ttag = null;
    switch (etype(type)) {
	case t_fixnum:
	case t_int:
	case t_float:
	case t_string:
	    goto fail;
	case t_tag:
	    ttag = type;
	    if (ttag->type != tag_struct && ttag->type != tag_class)
		goto fail;
	    break;
	default:
	    break;
    }

    switch (etype(cons)) {
	case t_fixnum:
	case t_int:
	case t_float:
	case t_string:
	    goto fail;
	case t_tag:
	    ctag = cons;
	    if (ctag->type != tag_struct && ctag->type != tag_class)
		goto fail;
	    break;
	default:
	    break;
    }

    if (ctag && ttag) {
	if (ctag->type != ttag->type)
	    goto fail;
	for (record = ctag->data; record; record = record->super)
	    if (record == ttag->data) {
		east_link(ecode_int(1));
		goto done;
	    }
	/* expression is not constant because it may have
	 * been evaluated before more type definitions */
    }

    if (ttag) {
	einteger(&type, etag_to_integer(ttag));
	eliteral(type);
    }
    else
	eeval(type);
    east_link(ecode_push());
    if (ctag) {
	einteger(&cons, etag_to_integer(ctag));
	eliteral(cons);
    }
    else
	eeval(cons);
    east_link(ecode_record_subtypeof());
    goto done;

fail:
    east_link(ecode_int(0));
done:
    return (int_tag);
}

static etag_t *
renew_expression(eobject_t list)
{
    etype_t	type;
    eobject_t	vector;
    eobject_t	length;
    eint32_t	offset;

    vector = ecar(list);
    length = ecadr(list);

    switch ((type = etype(vector))) {
	case t_cons:
	case t_symbol:
	    /* runtime */
	    break;
	default:
	    /* constant */
	    if (!evector_type_p(type))
		eparse_error(list, "bad constant 'renew' vector argument");
	    break;
    }

    /* load vector object */
    eeval(ecar(list));

    if (enumber_offset(length, &offset))
	east_link(ecode_vector_renew_static(offset));
    else {
	switch (etype(length)) {
	    case t_symbol:
	    case t_cons:
		east_link(ecode_push());
		eeval(length);
		east_link(ecode_vector_renew());
		break;
	    default:
		eparse_error(list, "bad constant 'renew' length argument");
	}
    }

    return (null);
}

static efunction_t *
prototype(eclass_t *record, etag_t *tag, ebool_t define,
	  esymbol_t *name, eobject_t list)
{
    eint32_t	 count;
    eobject_t	*proto;
    esymbol_t	*symbol;
    efunction_t	*lambda;

    if (!esymbol_p(name))
	eparse_error(null, "expecting symbol");

    if (record) {
	/* need to check fields because methods are in a separate hash */
	symbol = eget_symbol(record->fields, name->name);
	if (symbol)
	    eparse_error(null, "'%p.%p' redeclared as a different type",
			 record->name->name, emethod_name(record, symbol));
	/* now check if there is already a prototype */
	symbol = eget_symbol(record->methods, name->name);
    }
    else
	symbol = (esymbol_t *)eget_hash_entry(ht_root, (eentry_t *)name);

    if (symbol == null) {
	/* create new function */
	if (record)
	    lambda = enew_method(record, name);
	else
	    lambda = enew_function(define, name);
	symbol = lambda->name;

	symbol->tag = tag;
	symbol->type = etag_packed_p(tag);
	lambda->tag = etag_function(tag, list);
	proto = lambda->tag->data;
	lambda->args = eobject_length(proto) / sizeof(eobject_t);
	count = lambda->args - 1;
	/* if no implicit `this' pointer */
	if (record == null)
	    --lambda->args;
	if (proto[count] == ellipsis_obj) {
	    lambda->voffset = -(lambda->args + 1);
	    --lambda->args;
	}
    }
    else {
	if (symbol->a_builtin)
	    eparse_error(null, "cannot redefine '%p'", symbol->name);

	if (record)
	    lambda = eget_method(record, name);
	else
	    lambda = symbol->value;

	/* ensure prototype matches */
	if (!efunction_p(lambda))
	    eparse_error(null, "'%p' redeclared as a function", symbol->name);

	if (lambda->defined) {
	    if (record)
		eparse_error(null, "cannot redefine '%p.%p'",
			     record->name->name, emethod_name(record, symbol));
	    eparse_error(null, "cannot redefine '%p'", symbol->name);
	}

	if (symbol->tag != tag) {
	    if (record)
		eparse_error(null, "method '%p.%p' type mismatch",
			     record->name->name, emethod_name(record, symbol));
	    eparse_error(null, "function '%p' type mismatch", symbol->name);
	}

	if (lambda->tag != etag_function(tag, list)) {
	    if (record)
		eparse_error(null, "method '%p.%p' prototype mismatch",
			     record->name->name, emethod_name(record, symbol));
	    eparse_error(null, "function '%p' prototype mismatch",
			 symbol->name);
	}

	if (record == null && define && symbol->offset < 0)
	    ereference_function(symbol);
    }

    if (define) {
	/* FIXME This loop almost duplicates etag_function() work,
	 * just that now it is required to know about symbol names */
	count = -2;
	if (record) {
	    symbol = enew_symbol(lambda->hash, symbol_this->name);
	    symbol->offset = count;
	    symbol->tag = etag_object(record);
	    --count;
	}
	for (; list; list = ecdr(list), --count) {
	    if (eargument(list, &tag, (eobject_t *)&symbol)) {
		if (symbol == null)
		    eparse_error(null, "expecting declaration or symbol");
		if (eget_symbol(lambda->hash, symbol->name))
		    eparse_error(null, "symbol '%p' redeclared", symbol->name);
		symbol = enew_symbol(lambda->hash, symbol->name);
		symbol->offset = count;
		symbol->a_symbol = true;
		symbol->tag = tag;
		symbol->type = etag_packed_p(tag);
	    }
	}
    }

    return (lambda);
}

static void
function(eclass_t *record, etag_t *tag,
	 esymbol_t *name, eobject_t list, eobject_t code)
{
    east_node_t	*node;
    efunction_t	*save_fn;
    ehash_t	*save_ht;
    evector_t	*filename;

    /* save parent code */
    save_fn = fn_current;
    save_ht = ht_current;

    if (fn_current != fn_root)
	/* FIXME need to write support for local functions */
	eparse_error(null, "syntax error");

    /* change function object */
    fn_current = prototype(record, tag, true, name, list);
    ht_current = fn_current->hash;

    (void)new_block(tok_function);

    /* force updating file name in annotation */
    filename = note_name;
    note_name = null;

    /* parse code */
    for (; code; code = ecdr(code))
	eeval(ecar(code));

    /* restore to toplevel */
    note_name = filename;

    /* code must end in a return opcode */
    switch (east_node(east_tail())->code) {
	case eop_ret:			case eop_reti:
	case eop_rett:			case eop_retit:
	    break;
	default:
	    return_statement(null);
	    node = east_node(east_tail());
	    node->creturn.flags = code_return_implicit;
	    break;
     }

    del_block();

    efinalize_function(fn_current);

    /* restore parent code */
    fn_current = save_fn;
    ht_current = save_ht;
}

static void
return_statement(eobject_t list)
{
    etag_t	*tag;
    eblock_t	*block;
    esymbol_t	*symbol;
    eclass_t	*record;

    if (fn_current == fn_root)
	eparse_error(list, "'return' not in a function");

    /* FIXME if unnamed functions are implemented, correct here */
    symbol = fn_current->name;
    record = fn_current->record;
    tag = symbol->tag;

    /* check if return is from inside a try or catch block */
    for (block = code_block;
	 block && block->token != tok_catch &&
	 block->token != tok_try && block->token != tok_function;
	 block = block->parent)
	;
    if (block) {
	if (block->token == tok_try)
	    east_link(ecode_except_arg(eop_unwind, 0));
	else if (block->token == tok_catch) {
	    east_link(ecode_nil());
	    east_link(ecode_symbol_store(eget_symbol(fn_current->hash,
						     symbol_throw->name)));
	}
    }

    if (list) {
	if (tag == void_tag) {
	    if (record)
		eparse_error(list,
			     "'void' method '%p.%p' cannot return a value",
			     record->name->name, symbol->name);
	    eparse_error(list, "'void' function '%p' cannot return a value",
			 symbol->name);
	}
	if (record && symbol->a_ctor)
	    eparse_error(list, "constructor cannot explicitly return a value");
	eeval(ecar(list));
    }
    else if (tag != void_tag) {
	if (record && symbol->a_ctor)
	    east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
						    symbol_this->name)));
	else
	    east_link(ecode_nil());
    }

    east_link(ecode_return(fn_current->args + 1, fn_current->name ?
			   fn_current->name->tag : null));
}

static void
record_statement(etoken_t token, eobject_t list)
{
    etag_t	*tag;
    etag_t	*rtag;
    etag_t	*type;
    eobject_t	 cons;
    eobject_t	 form;
    esymbol_t	*ident;
    eobject_t	 pairs;
    eobject_t	 fields;
    erecord_t	*record;
    ehash_t	*current;

    cons = ecar(list);
    rtag = ecar(cons);
    record = rtag->data;
    current = ht_current;
    ht_current = record->fields;

    if ((cons = ecdr(cons))) {
	/* initialize class method table */
	if (token == tok_class)
	    eset_methods(record);

	v_check(1);
	pairs = null;
	v_push(null);

	for (; cons; cons = ecdr(cons)) {
	    fields = ecar(cons);
	    tag = ecar(fields);
	    switch (etype(tag)) {
		case t_tag:
		case t_void:
		    /* T fields; */
		    break;
		case t_fixnum:
		    switch (eget_fixnum(tag)) {
			case tok_ctor:
			    /* ctor declaration or definition */
			    tag = ecadr(fields);
			    if (token != tok_class || tag == null ||
				!etag_p(tag) || tag->data != record)
				goto record_fail;
			    prototype(record, null, false, symbol_new, null);
			    if (ecddr(fields))
				v_top() = pairs = econs(econs(null,
						econs(symbol_new,
						econs(null,
						econs(ecddr(fields),
						null)))), pairs);
			    continue;
			case tok_progn:
			    /* fields; */
			    tag = null;
			    break;
			default:
			    goto record_fail;
		    }
		    break;
		default:
		record_fail:
		    eparse_error(fields, "expecting declaration");
	    }

	    /* first element is type tag or tok_progn */
	    for (fields = ecdr(fields); fields; fields = ecdr(fields)) {
		form = ecar(fields);
		switch (etypename(tag, type_declare, form, form,
				  &type, (eobject_t *)&ident, &form,
				  false)) {
		    case type_declare:
			enew_field(record, ident->name, type);
			break;
		    case type_prototype:
			if (token != tok_class)
			    goto record_fail;
			/* method prototype */
			if (econs_p(ident)) {
			    if (ecar(ident) != record)
				goto record_fail;
			    ident = ecadr(ident);
			}
			prototype(record, type, false, ident, ecdr(form));
			break;
		    case type_function:
			if (token != tok_class)
			    goto record_fail;
			prototype(record, type, false,
				  ecar(ident), ecdr(ident));
			v_top() = pairs = econs(econs(type,
					econs(ecar(ident),
					econs(ecdr(ident),
					econs(ecdr(form),
					null)))), pairs);
			break;
		    case type_method_prototype:
			if (token != tok_class || ecar(ident) != record)
			    goto record_fail;
			prototype(record, type, false,
				  ecadr(ident), ecdr(form));
			break;
		    case type_method_function:
			if (token != tok_class || ecar(ident) != record)
			    goto record_fail;
			prototype(record, type, false,
				  ecadr(ident), ecdar(form));
			v_top() = pairs = econs(econs(type,
					econs(ecadr(ident),
					econs(ecdar(form),
					econs(ecdr(form),
					null)))), pairs);
			break;
		    default:
			goto record_fail;
		}
	    }
	}

	for (fields = pairs; fields; fields = ecdr(fields)) {
	    cons = ecar(fields);
	    form = ecddr(cons);
	    function(record, ecar(cons), ecadr(cons), ecar(form), ecadr(form));
	}
	v_dec();

	/* define struct/union */
	eend_record(record);
    }
    /* else do nothing, declaration already handled */

    ht_current = current;

    if ((list = ecdr(list)))
	declaration(rtag, list);
}

static void
declaration(etag_t *tag, eobject_t list)
{
    etag_t	*type;
    eobject_t	 form;
    eobject_t	 spec;
    eint32_t	 state;
    eblock_t	*block;
    eobject_t	 ident;
    ebool_t	 global;
    esymbol_t	*symbol;

    global = fn_current == fn_root;
    for (; list; list = ecdr(list)) {
	form = ecar(list);
	if (econs_p(form) && ecar(form) == efixnum(tok_set)) {
	    /* form: spec = value */
	    state = type_define;
	    form = ecdr(form);
	    spec = ecar(form);
	}
	else {
	    state = type_declare;
	    /* form: spec */
	    spec = form;
	}
	switch (etypename(tag, state, form, spec, &type, &ident, &spec, false)) {
	    case type_define:
		evariable(global, type, ident);
		set_expression(form);
		break;
	    case type_declare:
		if (global) {
		    symbol = eget_symbol(ht_root, ((esymbol_t *)ident)->name);
		    /* if symbol not already declared */
		    if (symbol == null) {
			symbol = enew_bound_symbol(ident);
			symbol->a_global = true;
			symbol->tag = type;
			symbol->type = etag_packed_p(type);
			symbol->offset = -1;
		    }
		    /* if another declaration, possibly after definition */
		    else if (symbol->tag != type)
			eparse_error(form, "symbol '%p' type mismatch",
				     symbol->name);
		}
		else {
		    elocal_variable(type, ident);
		    for (block = code_block;
			 block && block->token != tok_function;
			 block = block->parent) {
			if (ekind_of(block->token) == tok_loop) {
			    esymbol_store(ident, null);
			    break;
			}
		    }
		}
		break;
	    case type_prototype:
		prototype(null, type, false, ident, ecdr(spec));
		break;
	    case type_function:
		function(null, type, ecar(ident), ecdr(ident), ecdr(spec));
		break;
	    case type_method_prototype:
		prototype(ecar(ident), type, false, ecadr(ident), ecdr(spec));
		break;
	    case type_method_function:
		function(ecar(ident), type, ecadr(ident), ecdar(spec),
			 ecdr(spec));
		break;
	}
    }
}

static void
typedef_statement(etag_t *tag, eobject_t list)
{
    etag_t	*type;
    eobject_t	 form;
    esymbol_t	*ident;
    esymbol_t	*symbol;

    for (; list; list = ecdr(list)) {
	form = ecar(list);
	if (etypename(tag, type_declare, form, form,
		      &type, (eobject_t *)&ident, &form,
		      true) == type_declare) {
	    if (ident == null) {
		if (tag)
		    goto typedef_fail;
		continue;
	    }
	    symbol = eget_symbol(ht_language, ident->name);
	    if (symbol && symbol->a_type && symbol->value != type)
		eparse_error(ecar(list),
			     "'%p' redeclared as a different type",
			     ident->name);
	    if (echk_bound_symbol(ident))
		eparse_error(ecar(list),
			     "'%p' redeclared as a different object",
			     ident->name);
	    if (!symbol->a_type) {
		symbol = enew_symbol(ht_language, ident->name);
		symbol->a_type = true;
		symbol->value = type;
		symbol->tag = type;
		/* if the type already have a name, don't overwrite it */
		if (type && !type->name)
		    type->name = symbol;
	    }
	}
	else {
	typedef_fail:
	    eparse_error(ecar(list), "expecting declaration");
	}
    }
}

static void
try_statement(eobject_t list)
{
    east_node_t		*node;
    eobject_t		 form;
    etag_t		*type;
    esymbol_t		*ident;
    eblock_t		*block;
    eobject_t		 object;
    esymbol_t		*symbol;
    esymbol_t		*except;
    eint32_t		 tryoff;
    ebool_t		 dynamic;
    eint_t		 typeint;
    eobject_t		 typeobj;
    eobject_t		 catch_label;
    eobject_t		 rethrow_label;
    east_list_t		*type_switch_ast;
    eobject_t		 catch_rethrow_ast;
    eentry_t		*catch_rethrow_entry;
    v_enter();

    block = new_block(tok_try);
    enew_hash((eobject_t *)&block->table, H_string, 5);

    /* offset is resolved later */
    east_link(ecode_except(eop_try));
    block->label = ecreate_label(fn_current);
    /* the throw target instruction, that is also jumped over by eop_try */
    east_link(ecode_branch(eop_j, block->label));

    /* evaluate try code */
    eeval(ecar(list));
    list = ecdr(list);

    /* 'always' target, not to be confused with java's 'finally', but
     * having basically the same functionality; it is a chunk of code
     * that is always executed, regardless of an exception being
     * triggered or not, and should be used, usually, to synchronously
     * reclaim system (non memory) resources; 'synchronously', because
     * gc eventually will trigger and release the resource */
    object = ecar(list);

    if (object == null) {
	/* unwind stack and leave try block if no exception caught
	 * and no 'always' code block */
	east_link(ecode_except_arg(eop_unwind, 1));
	node = ecode_branch(eop_j, null);
	east_link(node);
	add_f_jump(block, node);
    }
    else
	/* load null because current loaded value is the result of
	 * last `try' block expression, and not the exception object */
	east_link(ecode_nil());

    /* throw target */
    east_label_link(ecode_label(block->label));
    east_link(ecode_except(eop_catch));

    /* shared offset for catch objects */
    if ((tryoff = fn_current->tryoff) < 0) {
	tryoff = fn_current->hash->offset++;
	assert(tryoff <= most_positive_fix32);
	fn_current->tryoff = tryoff;
	except = enew_symbol(fn_current->hash, symbol_throw->name);
	except->offset = tryoff;
    }
    else
	except = eget_symbol(fn_current->hash, symbol_throw->name);

    /* save catch object, or ensure it is not using
     * the result of the last try expression result */
    east_link(ecode_symbol_store(except));

    /* if there is an 'always' block */
    if (object) {
	/* the current try block non longer exists (was "destroyed"
	 * by the eop_catch opcode), so, throw here will search an
	 * upper level try block, and this is the expected behavior,
	 * otherwise, it could enter an infinite loop, repeatedly
	 * executing the 'always' block, and jumping back to its
	 * start again */
	eeval(object);
	/* reload catch test object */
	east_link(ecode_symbol_load(except));
    }

    /* if catch object is null (or zero), don't catch anything */
    node = ecode_branch(eop_jf, null);
    east_link(node);
    add_f_jump(block, node);

    /* convert object to integer representation of its type */
    east_link(ecode_record_typeof());

    /* add hash jump opcode, and remember about object, to add offset later */
    type_switch_ast = east_tail();
    east_link(ecode_switch());

    /* reserve space for jump to default/dynamic type, or no match (rethrow) */
    node = ecode_branch(eop_j, null);
    east_link(node);
    catch_rethrow_ast = east_tail();

    v_check(2);
    enew(&catch_rethrow_entry, entry);
    v_push(catch_rethrow_entry);
    catch_rethrow_entry->name = null;

    /* flag to know if a dynamic/default catch type exists */
    dynamic = false;

    catch_label = ecreate_label(fn_current);

    /* keep slot for case_add_label() */
    v_push(null);

    /* parse catch list */
    while ((list = ecdr(list))) {
	evector_t	*catches;
	eobject_t	*pointer;

	object = ecar(list);
	form = ecar(object);
	if (econs_p(form)) {
	    type = ecar(form);
	    form = ecadr(form);
	}
	else
	    type = null;
	if (etypename(type, type_declare, form, form, &type,
		      (eobject_t *)&ident, &form, false) == type_declare &&
	    ident != null) {
	    typeint = etag_to_integer(type);
	    einteger(&typeobj, typeint);
	    if ((typeint == 0 && dynamic) ||
		eget_hash(block->table, typeobj))
		eparse_error(null, "duplicated 'catch' type");
	    /* create binding for ident, that is only valid in this block */
	    symbol = enew_bound_symbol(ident);
	    symbol->offset = tryoff;
	    symbol->tag = type;
	    /* create jump label for this catch type */
	    if (typeint == 0) {
		dynamic = true;
		form = ecreate_label(fn_current);
		node->clabel.label = form;
		catch_rethrow_entry->value = ecode_label(form);
		east_label_link(ecode_label(form));
	    }
	    else
		case_add_label(block->table, typeobj, false);
	}
	else
	    eparse_error(econs_p(form) ? form : object,
			 "expecting declaration");
	(void)new_block(tok_catch);
	eeval(ecadr(object));
	del_block();
	/* proceed after finished handling exception */
	east_link(ecode_branch(eop_j, catch_label));

	/* ensure symbol is gc protected as it may be referenced only
	 * from an east_node_t during code generation, and east_node_t
	 * objects are mean't to not have objects reachable only from them */
	if ((catches = fn_current->catches) == null) {
	    evector(&fn_current->catches, t_void, 4, 1);
	    catches = fn_current->catches;
	}
	else if (catches->offset >= catches->length)
	    erenew_vector(catches, catches->length + 4);
	pointer = catches->v.ptr;
	pointer[catches->offset++] = symbol;

	/* unbound symbol (so that it can be redeclared in another catch) */
	erem_hash(ht_current, (eentry_t *)symbol);
    }

    /* if there isn't a catch "all" entry, must have a rethrow label */
    if (dynamic == false) {
	rethrow_label = ecreate_label(fn_current);
	node->clabel.label = rethrow_label;
	catch_rethrow_entry->value = ecode_label(rethrow_label);

	east_label_link(ecode_label(rethrow_label));
	/* reload exception object */
	east_link(ecode_symbol_load(except));
	east_link(ecode_except_arg(eop_throw, 0));
    }

    east_label_link(ecode_label(catch_label));
    /* set exception "hidden" variable to null, that is, let
     * the exception catch object to be garbage collected */
    east_link(ecode_nil());
    east_link(ecode_symbol_store(except));

    switch_finalize(block, type_switch_ast, catch_rethrow_ast,
		    catch_rethrow_entry);

    del_block();
    v_leave();
}

static void
throw_statement(eobject_t list)
{
    eblock_t	*block;
    eint32_t	 argument;

    argument = 0;
    if (list)
	eeval(ecar(list));
    else {
	for (block = code_block;
	     block && block->token != tok_catch &&
	     block->token != tok_try && block->token != tok_function;
	     block = block->parent)
	    ;
	if (block && block->token == tok_catch)
	    /* (re)load catch object */
	    east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
						    symbol_throw->name)));
	else
	    /* rethrow exception */
	    argument = 1;
    }

    east_link(ecode_except_arg(eop_throw, argument));
}

static void
ctor_statement(eobject_t list)
{
    etag_t	*tag;

    tag = ecar(list);
    list = ecdr(list);
    if (list)
	/* out of class body constructor definition */
	function(tag->data, null, symbol_new, null, list);
    else {
	/* explicit constructor call */
	east_link(ecode_symbol_load(eget_symbol(fn_current->hash,
						symbol_this->name)));
	eapply_method(true, tag, symbol_new, null);
    }
}
